home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / SAMPLES.ZIP / PAISANOS.FRG < prev    next >
Text File  |  1994-10-12  |  8KB  |  390 lines
  1. * Programa...........: C:\DBASE20\EJEMPLOS\PAISANOS.FRG
  2. * Fecha..............: 2-23-93
  3. * Versión............: dBASE IV, Informes 2.0
  4. *
  5. * Notas:
  6. * ------
  7. * Antes de ejecutar este procedimiento con el mandato DO
  8. * es necesario usar LOCATE, pues la sentencia CONTINUE
  9. * está en el bucle principal.
  10. *
  11. *-- Parámetros
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** Los tres primeros parámetros son de tipo lógico
  14. ** El cuarto es una serie y el quinto es un parámetro adicional.
  15. PRIVATE _peject, _wrap
  16.  
  17. *-- Comprueba si no se ha encontrado ningún registro
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- Desactiva la justificación entre márgenes.
  23. _wrap=.F.
  24.  
  25. IF _plength < (_pspacing * 4 + 1) + 1 + 2
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Aumente la longitud de página del informe."
  30.    @ 2,1 SAY "Pulse una tecla ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && pone el número de líneas a cero
  38. *-- Parámetro NOEJECT
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Establecimiento de entorno
  49. ON ESCAPE DO Prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && Tiempo del sistema para el campo predefinido
  59. gd_date=DATE()      && Fecha del sistema  "    "    "     "
  60. gl_fandl=.F.        && indicador de primera y última página
  61. gl_prntflg=.T.      && indicador de continuar impresión
  62. gl_widow=.T.        && indicador de comprobar apartados viudos
  63. gn_length=LEN(gc_heading)  && almacena la longitud del encabezamiento (HEADING)
  64. gn_level=2          && apartado actual en proceso
  65. gn_page=_pageno     && captura el número de página actual
  66. gn_pspace=_pspacing && captura el interlineado de la página impresa actual
  67.  
  68.  
  69. *-- Activa el procedimiento para el salto de página
  70. gn_atline=_plength - 1
  71. ON PAGE AT LINE gn_atline EJECT PAGE
  72.  
  73. *-- Imprime el informe
  74.  
  75. PRINTJOB
  76.  
  77. *-- Inicializa las variables del cambio de grupo
  78. r_mvar4=PROVINCIA
  79.  
  80. *-- Inicializa las variables del resumen.
  81. r_msum1=0
  82. r_msum2=0
  83.  
  84. IF gl_plain
  85.    ON PAGE AT LINE gn_atline DO Pgplain
  86. ELSE
  87.    ON PAGE AT LINE gn_atline DO Pgfoot
  88. ENDIF
  89.  
  90. DO Pghead
  91.  
  92. gl_fandl=.T.        && comienzo de la primera página física
  93.  
  94. DO Rintro
  95.  
  96. DO Grphead
  97.  
  98. *-- Bucle de fichero
  99. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  100.    DO CASE
  101.    CASE PROVINCIA <> r_mvar4
  102.       gn_level=4
  103.    OTHERWISE
  104.       gn_level=0
  105.    ENDCASE
  106.    *-- comprueba si alguna expresión no ha casado
  107.    IF gn_level <> 0
  108.       DO Grpfoot WITH 100-gn_level
  109.       DO Grpinit
  110.    ENDIF
  111.    *-- Repite las introducciones de grupo
  112.    IF gn_level <> 0
  113.       DO Grphead
  114.    ENDIF
  115.    gn_level=0
  116.    *-- Cuerpo del informe
  117.    IF gl_summary
  118.       DO Upd_Vars
  119.    ELSE
  120.       DO __Detail
  121.    ENDIF
  122.    gl_widow=.T.         && activa la comprobación de apartados viudos
  123.    CONTINUE
  124. ENDDO
  125.  
  126. IF gl_prntflg
  127.    gn_level=3
  128.    DO Grpfoot WITH 97
  129.    DO Rsumm
  130. ELSE
  131.    gn_level=3
  132.    DO Rsumm
  133.    DO Reset
  134.    RETURN
  135. ENDIF
  136.  
  137. ON PAGE
  138.  
  139. ENDPRINTJOB
  140.  
  141. DO Reset
  142. RETURN
  143. * EOP: C:\DBASE20\EJEMPLOS\PAISANOS.FRG
  144.  
  145. *-- Determina la altura de los Apartados de Grupo y de informe por si hay apartados viudos
  146. FUNCTION Gheight
  147. PARAMETER Group_Band
  148. retval=0              && Valor devuelto
  149. IF Group_Band <= 4
  150.    retval = retval + 3 * gn_pspace
  151. ENDIF
  152. *-- suma la altura del Apartado del cuerpo del informe
  153. retval = retval + 3 * gn_pspace
  154. RETURN retval
  155. * EOP: Gheight
  156.  
  157. *-- Actualiza los campos resumen y/o los campos calculados.
  158. PROCEDURE Upd_Vars
  159. *-- Contador
  160. r_msum1=r_msum1+1
  161. *-- Contador
  162. r_msum2=r_msum2+1
  163. RETURN
  164. * EOP: Upd_Vars
  165.  
  166. *-- Desactiva el indicador para salir del bucle DO WHILE cuando se pulse ESC
  167. PROCEDURE Prnabort
  168. gl_prntflg=.F.
  169. RETURN
  170. * EOP: Prnabort
  171.  
  172. *-- Reinicializa las variables de cambio de grupo, y los campos
  173. *-- resumen que vuelvan a empezar el cálculo cada apartado particular.
  174. PROCEDURE Grpinit
  175. IF gn_level <= 4
  176.    r_msum1=0
  177. ENDIF
  178. IF gn_level <= 4
  179.    r_mvar4=PROVINCIA
  180. ENDIF
  181. RETURN
  182. * EOP: Grpinit
  183.  
  184. *-- Procesa la Introducción de los grupos al cambiar de grupo
  185. PROCEDURE Grphead
  186. IF EOF()
  187.    RETURN
  188. ENDIF
  189. PRIVATE _pspacing
  190. _pspacing=gn_pspace
  191. IF gn_level = 0
  192.    gn_level=50
  193. ENDIF
  194. IF gn_level = 4
  195.    IF 3 * gn_pspace  < gn_atline
  196.       IF (gl_widow .AND. _plineno+Gheight(4) > gn_atline + 1) ;
  197.       .OR. (gl_widow .AND. _plineno+3 * gn_pspace > gn_atline)
  198.          EJECT PAGE
  199.       ENDIF
  200.    ENDIF
  201. ENDIF
  202. IF gn_level <= 4
  203.    DO Head4
  204. ENDIF
  205. gn_level=0
  206. RETURN
  207. * EOP: Grphead.PRG
  208.  
  209. *-- Procesa el Apartado de Resumen de Grupos al cambiar de grupos
  210. PROCEDURE Grpfoot
  211. PARAMETER ln_level
  212. IF ln_level >= 96
  213.    DO Foot96
  214. ENDIF
  215. RETURN
  216. * EOP: Grpfoot.PRG
  217.  
  218. PROCEDURE Pghead
  219. PRIVATE ll_heading, ln_width
  220. ll_heading = .T.
  221. ln_width = _rmargin - _lmargin
  222. IF _wrap
  223.    PRIVATE _wrap
  224.    _wrap = .F.
  225. ENDIF
  226. ?
  227. *-- Parámetros para imprimir la cabecera - si no cabe en una línea
  228. *-- El valor añadido a gn_length es la última columna de la primera línea dos veces
  229. IF .NOT. gl_plain .AND. gn_length + 30 > ln_width
  230.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  231.    ?
  232.    ll_heading = .F.
  233. ENDIF
  234.  
  235. ?? "Página Nº" AT 3,;
  236.  IIF(gl_plain,'',_pageno) PICTURE "99" 
  237.  
  238. *-- Parámetros para imprimir la cabecera - si cabe en la primera línea
  239. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  240.    ?? " "
  241.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  242. ENDIF
  243. ?
  244. IF .NOT. gl_plain
  245.    ?? gd_date AT 3
  246.    ?
  247. ENDIF
  248. ?
  249. RETURN
  250. * EOP: Pghead
  251.  
  252. PROCEDURE Rintro
  253. PRIVATE _indent, _lmargin, _rmargin, _tabs
  254. IF .NOT. _wrap
  255.    PRIVATE _wrap
  256.    _wrap = .T.
  257. ENDIF
  258. ?
  259. _lmargin=0
  260. _indent=0
  261. _rmargin=254
  262. _pcolno=0
  263. _tabs=;
  264. "8,16,24,32,40,48,56,64,72,80,88,96,104,112,120,128,136,144,152,160,168";
  265. + ",176,184,192,200,208,216,224,232,240";
  266.  
  267. ?? "                 AGENDA DE DIRECCIONES" 
  268. ?
  269. ?
  270. ?
  271. _pcolno=0
  272. ?? "               Organizada por Provincias" 
  273. ?
  274. _pcolno=0
  275. ?? "                 De la vista 'Invitado'" 
  276. ?
  277. ?
  278. ?
  279. _pcolno=0
  280. EJECT PAGE
  281. ?
  282. RETURN
  283. * EOP: Rintro
  284.  
  285. PROCEDURE Head4
  286. IF gn_level=1
  287.    RETURN
  288. ENDIF
  289. IF _wrap
  290.    PRIVATE _wrap
  291.    _wrap = .F.
  292. ENDIF
  293. ?
  294. ?? "Amigos en " AT 7,;
  295.  Provincia FUNCTION "T" ,;
  296.  ":" 
  297. ?
  298. ?? "=================================================" AT 7
  299. ?
  300. RETURN
  301.  
  302. PROCEDURE __Detail
  303. IF _wrap
  304.    PRIVATE _wrap
  305.    _wrap = .F.
  306. ENDIF
  307. IF 3 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
  308.    IF gl_widow .AND. _plineno+3 * gn_pspace > gn_atline + 1
  309.       EJECT PAGE
  310.    ENDIF
  311. ENDIF
  312. DO Upd_Vars
  313. ?
  314. ?? Nombre FUNCTION "T" AT 7,;
  315.  " " ,;
  316.  Apellido FUNCTION "T" ,;
  317.  Telefono FUNCTION "T" AT 41
  318. ?
  319. ?? Direccion FUNCTION "T" AT 7,;
  320.  Ciudad FUNCTION "T" AT 29,;
  321.  ", " ,;
  322.  Provincia FUNCTION "T" ,;
  323.  Cod_post FUNCTION "T" AT 49
  324. ?
  325. RETURN
  326. * EOP: __Detail
  327.  
  328. PROCEDURE Foot96
  329. IF _wrap
  330.    PRIVATE _wrap
  331.    _wrap = .F.
  332. ENDIF
  333. ?
  334. ?? "-------------------------------------------------" AT 7
  335. ?
  336. ?? "Amigos en esta provincia: " AT 7,;
  337.  r_msum1 PICTURE "999" 
  338. ?
  339. ?
  340. RETURN
  341.  
  342. PROCEDURE Rsumm
  343. IF _wrap
  344.    PRIVATE _wrap
  345.    _wrap = .F.
  346. ENDIF
  347. ?
  348. ?? "-------------------------------------------------" AT 7
  349. ?
  350. ?? "Número de direcciones en la agenda: " AT 7,;
  351.  r_msum2 PICTURE "999" 
  352. gl_fandl=.F.        && terminada la última página
  353. ?
  354. RETURN
  355. * EOP: Rsumm
  356.  
  357. PROCEDURE Pgfoot
  358. PRIVATE _box
  359. gl_widow=.F.         && desactiva la comprobación de líneas viudas
  360. EJECT PAGE
  361. *-- comprueba si el número de página es mayor que el de la última página
  362. IF _pageno > _pepage
  363.    GOTO BOTTOM
  364.    SKIP
  365.    gn_level=0
  366. ENDIF
  367. IF .NOT. gl_plain .AND. gl_fandl
  368.    _pspacing=gn_pspace
  369.    DO Pghead
  370. ENDIF
  371. RETURN
  372. * EOP: Pgfoot
  373.  
  374. *-- Proceso de los saltos de página cuando se usa la opción PLAIN
  375. PROCEDURE Pgplain
  376. PRIVATE _box
  377. EJECT PAGE
  378. RETURN
  379. * EOP: Pgplain
  380.  
  381. *-- Restaura el entorno de dBASE previo a la impresión del informe
  382. PROCEDURE Reset
  383. SET SPACE &gc_space.
  384. SET TALK &gc_talk.
  385. ON ESCAPE
  386. ON PAGE
  387. RETURN
  388. * EOP: Reset
  389.  
  390.